require(tidyverse)
## Loading required package: tidyverse
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
## ✔ ggplot2 3.3.6     ✔ purrr   0.3.4
## ✔ tibble  3.1.7     ✔ dplyr   1.0.9
## ✔ tidyr   1.2.0     ✔ stringr 1.4.0
## ✔ readr   2.1.2     ✔ forcats 0.5.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
require(dplyr)
require(ggplot2)
require(gganimate)
## Loading required package: gganimate

Introduction

For this project, I looked attempted to create fun visualization of track and field (mainly events from the track) run time results for the Women & Men’s 100M dashes. I played around with the idea of making the data race each other like actual track and field athlete do. An ultimate goal is to graph an oval track and let the times race on the track

Data Wrangling

f <- "https://raw.githubusercontent.com/jyhrehjohnson/creative-data-visualization/main/results.csv"
d <- read_csv(f, col_names = TRUE)
## Warning: One or more parsing issues, see `problems()` for details
## Rows: 2394 Columns: 8
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (7): Gender, Event, Location, Medal, Name, Nationality, Result
## dbl (1): Year
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
head(d)
## # A tibble: 6 × 8
##   Gender Event      Location  Year Medal Name                 Nationality Result
##   <chr>  <chr>      <chr>    <dbl> <chr> <chr>                <chr>       <chr> 
## 1 M      10000M Men Rio       2016 G     Mohamed FARAH        USA         25:05…
## 2 M      10000M Men Rio       2016 S     Paul Kipngetich TAN… KEN         27:05…
## 3 M      10000M Men Rio       2016 B     Tamirat TOLA         ETH         27:06…
## 4 M      10000M Men Beijing   2008 G     Kenenisa BEKELE      ETH         27:01…
## 5 M      10000M Men Beijing   2008 S     Sileshi SIHINE       ETH         27:02…
## 6 M      10000M Men Beijing   2008 B     Micah KOGO           KEN         27:04…

Data filtering

#select the data to remove location and athlete name
d <- d %>%
  select(Gender,
         Event,
         Year,
         Medal,
         Nationality,
         Result
         )
#filter event column for only Men and Women 100M dashes
d_100M_Men <- d %>% filter (Event == "100M Men")
d_100M_Men
## # A tibble: 82 × 6
##    Gender Event     Year Medal Nationality Result
##    <chr>  <chr>    <dbl> <chr> <chr>       <chr> 
##  1 M      100M Men  2016 G     JAM         9.81  
##  2 M      100M Men  2016 S     USA         9.89  
##  3 M      100M Men  2016 B     CAN         9.91  
##  4 M      100M Men  2008 G     JAM         9.69  
##  5 M      100M Men  2008 S     TTO         9.89  
##  6 M      100M Men  2008 B     USA         9.91  
##  7 M      100M Men  2000 G     USA         9.87  
##  8 M      100M Men  2000 S     TTO         9.99  
##  9 M      100M Men  2000 B     BAR         10.04 
## 10 M      100M Men  1992 G     GBR         9.96  
## # … with 72 more rows
d_100M_Women <- d %>% filter(Event == "100M Women")
d_100M_Women
## # A tibble: 60 × 6
##    Gender Event       Year Medal Nationality Result
##    <chr>  <chr>      <dbl> <chr> <chr>       <chr> 
##  1 W      100M Women  2016 G     JAM         10.71 
##  2 W      100M Women  2016 S     USA         10.83 
##  3 W      100M Women  2016 B     JAM         10.86 
##  4 W      100M Women  2008 G     JAM         10.78 
##  5 W      100M Women  2008 S     JAM         10.98 
##  6 W      100M Women  2008 S     JAM         10.98 
##  7 W      100M Women  2000 S     GRE         11.12 
##  8 W      100M Women  2000 S     JAM         11.18 
##  9 W      100M Women  2000 B     JAM         11.19 
## 10 W      100M Women  1992 G     USA         10.82 
## # … with 50 more rows

LET THE RACES BEGIN!!!!

Medal Times Race (Plot Race)
These two sets of visualizations, graph the Gold, Silver, & Bronze Medal times from the 1932 Olympics to the 2016 Olympics.

Women’s 100M Medal Times from 1932-2016

w_Year_Tracker <- d_100M_Women %>% #pipe the filtered data through
  ggplot() + 
    geom_point(aes(x = Year, y = Result, col = Medal), 
    alpha = 0.8) + #set the parameter data for the plot
    theme(legend.position = "right") + #create & set position of legend
    guides(size = "none") + 
    labs(x = "Year",y = "Run Time Results (sec)", title = "Women's 100M Medal Times (1932 - 2016)", col = "Medal Type") + #set the x and y axis labels and title
    geom_text(aes(x = min(Year), y = min(Result), label = as.factor(Year)), hjust=0, vjust = -0.2, alpha = 0.2,  col = "gray", size = 20) + #use data to set column/row text and length of the graph
    transition_states(as.factor(Year), state_length = 0) #separates the data by year to be projected on graph

w_Year_Tracker #run the year tracker

anim_save("w_Year_Tracker.gif") #save the animation as a gif

Men’s 100M Medal Times from 1896-2016

m_Year_Tracker <- d_100M_Men %>% #pipe the filtered data through
  ggplot() + 
    geom_point(aes(x = Year, y = Result, col = Medal), 
    alpha = 0.8) + #set the parameter data for the plot
    theme(legend.position = "right") + guides(size = "none") + #create & set position of legend
    labs(x = "Year", y = "Run Time Results (sec)", title = "Men's 100M Medal Times (1896 - 2016)", col = "Medal Type") + #set the x and y axis labels and title 
    geom_text(aes(x = min(Year), y = min(Result), label = as.factor(Year)) , hjust=-2, vjust = -0.2, alpha = 0.2,  col = "gray", size = 20) + #use data to set column/row text and length of the graph
    transition_states(as.factor(Year), state_length = 0) #separates the data by year to be projected on graph

m_Year_Tracker #run the year tracker

anim_save("m_Year_Tracker.gif") #save the animation as a gif

Nationality Times Race (Bar Race) This set of bar graphs plots the result times by Nationality of each medalled athlete.This section took me a while to figure out how to order the Medals (G, S, B) and correspond them to (1,2,3). But I GOT IT!!!
[Disclaimer - It won’t be much of a race since the times are so close, but none the less it’s a RACE!!]

Women’s Race

#create a new data frame that groups the data by year
w_race <- d_100M_Women %>%
  group_by(Year) %>%
  arrange(factor(Medal, levels = c('G', 'S', 'B')))%>% #arrange the Medal column for the order G,S,B
  arrange(Year)%>% #arrange the data by year
  mutate(ranking = row_number()) #create a ranking column to align with the medal type (G = 1, S = 2, B = 3)
  
head(w_race) #print/check the new data set  
## # A tibble: 6 × 7
## # Groups:   Year [2]
##   Gender Event       Year Medal Nationality Result ranking
##   <chr>  <chr>      <dbl> <chr> <chr>       <chr>    <int>
## 1 W      100M Women  1928 G     USA         12.2         1
## 2 W      100M Women  1928 S     CAN         None         2
## 3 W      100M Women  1928 B     CAN         None         3
## 4 W      100M Women  1932 G     POL         11.9         1
## 5 W      100M Women  1932 S     CAN         11.9         2
## 6 W      100M Women  1932 B     USA         12.0         3
w_bar_Race <- w_race %>% #pipe the new dataset through
  ggplot() +
  geom_col(aes(ranking, Year, fill = Nationality)) +
  geom_text(aes(ranking, Year, label = Result), hjust = -0.1) +
  geom_text(aes(ranking, y = 0 , label = Nationality), hjust = 1.1) +
  geom_text(aes(x = 15, y = max(Year) , label = as.factor(Year)), vjust = 0.2, alpha = 0.5,  col = "gray", size = 20) +
  coord_flip(clip = "off", expand = FALSE) + scale_x_reverse() +
  theme_minimal() + theme(
    panel.grid = element_blank(), 
    legend.position = "none",
    axis.ticks.y = element_blank(),
    axis.title.y = element_blank(),
    axis.text.y = element_blank(),
    plot.margin = margin(1, 4, 1, 3, "cm")
  ) +
  transition_states(Year, state_length = 0, transition_length = 2) +
  enter_fade() + #fade the bar in 
  exit_fade() + #fade the bar out
  ease_aes('quadratic-in-out') #transition of the 2 components in and out 

wb_race <- animate(w_bar_Race, fps = 25, duration = 15, rewind = FALSE) #run the animation
wb_race

anim_save("wb_race.gif") #save the animation as a gif

Men’s Race

#create a new data frame that groups the data by year
m_race <- d_100M_Men %>%
  group_by(Year) %>%
  arrange(factor(Medal, levels = c('G', 'S', 'B')))%>% #arrange the Medal column for the order G,S,B
  arrange(Year)%>% #arrange the data by year
  mutate(ranking = row_number()) #create a ranking column to align with the medal type (G = 1, S = 2, B = 3)
  
head(m_race) #print/check the new data set 
## # A tibble: 6 × 7
## # Groups:   Year [2]
##   Gender Event     Year Medal Nationality Result ranking
##   <chr>  <chr>    <dbl> <chr> <chr>       <chr>    <int>
## 1 M      100M Men  1896 G     USA         12.0         1
## 2 M      100M Men  1896 S     GER         12.2         2
## 3 M      100M Men  1896 B     HUN         12.6         3
## 4 M      100M Men  1896 B     USA         12.6         4
## 5 M      100M Men  1900 G     USA         11.0         1
## 6 M      100M Men  1900 S     USA         11.1         2
m_bar_Race <- m_race %>% #pipe the new dataset through
  ggplot() +
  geom_col(aes(ranking, Year, fill = Nationality)) +
  geom_text(aes(ranking, Year, label = Result), hjust = -0.1) +
  geom_text(aes(ranking, y = 0 , label = Nationality), hjust = 1.1) +
  geom_text(aes(x = 15, y = max(Year) , label = as.factor(Year)), vjust = 0.2, alpha = 0.5,  col = "gray", size = 20) +
  coord_flip(clip = "off", expand = FALSE) + scale_x_reverse() +
  theme_minimal() + theme(
    panel.grid = element_blank(), 
    legend.position = "none",
    axis.ticks.y = element_blank(),
    axis.title.y = element_blank(),
    axis.text.y = element_blank(),
    plot.margin = margin(1, 4, 1, 3, "cm")
  ) +
  transition_states(Year, state_length = 0, transition_length = 2) +
  enter_fade() + #fade the bar in 
  exit_fade() + #fade the bar out
  ease_aes('quadratic-in-out') #transition of the 2 components in and out 

mb_race <- animate(m_bar_Race, fps = 25, duration = 15, rewind = FALSE) #run the animation
mb_race

anim_save("mb_race.gif") #save the animation as a gif